home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d20 / autohtc.arc / AUTOHTC.PRG < prev    next >
Text File  |  1991-08-23  |  7KB  |  230 lines
  1. *:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2. *::::  BMMENU.prg
  3. *::::  Startprogramm für BM-Menüsystem
  4. *::::  (c) 1990 by B. Matthias
  5. *::::  Alle Rechte bei Systemberatung B. Matthias
  6. *:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  7.  
  8. # include data.hdr
  9. # include database.hdr
  10. # include date.hdr
  11. # include error.hdr
  12. # include fileio.hdr
  13. # include io.hdr
  14. # include keys.hdr
  15. # include string.hdr
  16. # include system.hdr
  17. # include JDstr.hdr
  18. # include JDfil.hdr
  19. vardef                                  && Variablendeklaration
  20.         uint            HOWMANY         && Wieviel Files gefunden
  21.         char(12)        FNAME[64]       && Filenamen
  22.         ulong           FSIZE[64]       && Filegroesse
  23.         char(8)         FDATE[64]       && Filedatum
  24.         char(6)         FTIME[64]       && Filezeit
  25.         char(6)         FATTR[64]       && Fileattribut
  26.         logical         ANYOTHERS       && Nochmehr Files
  27.         int(1)          OPTION=1        && Menüoption
  28.         uint            I               && Zähler
  29.         uint            IDX
  30.         uint            BONNY
  31.         logical         OK=.T.          && OK-Abfrage
  32.         byte            COL_NO          && Farbcode
  33.         char(30)        M_VAR
  34.         char(255)       M_FBBS          && Puffer für FILES.BBS
  35.         char(1)         M_TRENN         && Trennzeichen
  36.         char(255)       M_HPFAD[50]     && Pfade zum Hatchen
  37.         char(20)        M_HNAME[50]     && Hatchname
  38.         file            M_BBS           && Datei FILES.BBS
  39.         file            M_CFG           && Datei AUTOHTC.CFG
  40.         int(2)          M_AHATCH        && Anzahl Areas zum Hatchen
  41.         char(50)        M_DESC          && File-Beschreibung
  42.         char(8)         M_DATE          && File-Datum
  43.         char            M_COMMAND       && Hatch-Kommandozeile
  44.         uint            CDIR
  45.         char            OVERCOME        && DOS Parameter
  46.         char            OVERGOT         && Übernommener Parameter
  47. enddef
  48.  
  49. *
  50. *-------------------------------------------------------------------------------
  51. * Prozedur: Fehlermeldung anzeigen und Ende
  52. *
  53.  
  54. Procedure ERROR_PROC
  55.    clear
  56.    ? str(__errcode,4,0)+" "+e_message()
  57.    quit
  58. endpro
  59.  
  60. *
  61. *-------------------------------------------------------------------------------
  62. * Prozedur: Startbildschirm anzeigen
  63. *
  64.  
  65. Procedure ShowHeader
  66.    clear
  67.    set color to "B/BG"
  68.    @  0, 0 say " BM-Hatch v1.1ß (c) 1990 by B. Matthias - Automatic hatch of files     "+dtoc(today())+" "
  69.    @ 24, 0 say " -----                  You find me at Fidonet 2:245/60                   ----- "
  70.    set color to "W/B"
  71.    @  1, 0 clear to 23,79
  72.    @  1, 0 say ""
  73. endpro
  74.  
  75.  
  76. *
  77. *-------------------------------------------------------------------------------
  78. * Funktion: Control-File lesen
  79. * Rückgabe: keine
  80. *
  81. function logical READCFG
  82.    if .not. f_open(M_CFG, "AUTOHTC.CFG", &F_READ)
  83.       return .F.
  84.    endif
  85.    M_AHATCH=0
  86.    do while .not. f_eof(M_CFG) .and. M_AHATCH<50
  87.       OK=f_getln(M_CFG, M_HPFAD[M_AHATCH])
  88.       M_HNAME[M_AHATCH]=alltrim(substr(M_HPFAD[M_AHATCH],at(chr(32),M_HPFAD[M_AHATCH]),20))
  89.       M_HPFAD[M_AHATCH]=substr(M_HPFAD[M_AHATCH],1,at(chr(32),M_HPFAD[M_AHATCH])+1)
  90.       M_AHATCH=M_AHATCH+1
  91.    enddo
  92.    f_close(M_CFG)
  93.    return .T.
  94. endpro
  95.  
  96.  
  97. *
  98. *-------------------------------------------------------------------------------
  99. * Funktion: Files.Bbs einlesen
  100. * Rückgabe: keine
  101. *
  102. function logical READBBS
  103.    if .not. f_open(M_BBS, rtrim(M_HPFAD[I])+"\FILES.BBS", &F_READ)
  104.       return .F.
  105.    endif
  106.    do while .not. f_eof(M_BBS) .and. IDX<250
  107.       OK=f_getln(M_BBS, M_FBBS)
  108.       if trim(substr(M_FBBS,1,12))=rtrim(FNAME[IDX])
  109.          M_DESC=rtrim(substr(M_FBBS,at(M_TRENN,M_FBBS)+2,50))
  110.          f_close(M_BBS)
  111.          return .T.
  112.       endif
  113.    enddo
  114.    f_close(M_BBS)
  115.    return .F.
  116. endpro
  117.  
  118.  
  119. *
  120. *-------------------------------------------------------------------------------
  121. * Prozedur: Fileverzeichnis lesen
  122. *
  123. Procedure HATCH
  124. CDIR=1
  125. repeat
  126.    HOWMANY=adir(rtrim(M_HPFAD[I])+"\*.*", FNAME[], FSIZE[], FDATE[], FTIME[], FATTR[], "RH", CDIR, .T., ANYOTHERS)
  127.    CDIR=CDIR+64
  128.    for IDX=0 to HOWMANY-1
  129.        if ctod(FDATE[IDX])>=ctod(M_DATE) .and. FNAME[IDX]<>"FILES.BBS" .and. FNAME[IDX]<>"FILES.BAK"
  130.           do ShowHeader
  131.           if READBBS()
  132.              ? " Hatching: "+rtrim(FNAME[IDX])
  133.              BONNY=filerename(rtrim(M_HPFAD[I])+"\FILES.BBS",rtrim(M_HPFAD[I])+"\FILES.BMS")
  134.              if BONNY=0
  135.                 ? " Renamed : "+rtrim(M_HPFAD[I])+"\FILES.BBS"
  136.                 M_COMMAND="HATCH /r0 /a"+rtrim(M_HNAME[I])+" /f"+rtrim(FNAME[IDX])+" /ON /d"+rtrim(M_DESC)
  137.                 run M_COMMAND
  138.                 BONNY=filedelete(rtrim(M_HPFAD[I])+"\FILES.BBS")
  139.                 if BONNY=0
  140.                    ? " Deleted : "+rtrim(M_HPFAD[I])+"\FILES.BBS"
  141.                 else
  142.                    ? " Not deleted : "+rtrim(M_HPFAD[I])+"\FILES.BBS"
  143.                    ? " with errorlevel : "+str(BONNY,2,0)
  144.                 endif
  145.                 BONNY=filerename(rtrim(M_HPFAD[I])+"\FILES.BMS",rtrim(M_HPFAD[I])+"\FILES.BBS")
  146.                 if BONNY=0
  147.                    ? " Renamed : "+rtrim(M_HPFAD[I])+"\FILES.BMS"
  148.                 else
  149.                    ? " Not renamed : "+rtrim(M_HPFAD[I])+"\FILES.BMS"
  150.                    ? " with errorlevel : "+str(BONNY,2,0)+chr(7)
  151.                 endif
  152.              else
  153.                 ? " Not renamed : "+rtrim(M_HPFAD[I])+"\FILES.BBS"
  154.                 ? " with errorlevel : "+str(BONNY,2,0)+chr(7)
  155.              endif
  156.           else
  157.              ? " "+rtrim(M_HPFAD[I])+"\FILES.BBS not found !!!"+chr(7)
  158.              ? " File not found : "+FNAME[IDX]
  159.              ? " File NOT hatched"
  160.           endif
  161.        endif
  162.        inkey()
  163.        if lastkey()=&K_ESC
  164.           quit
  165.        endif
  166.    next
  167.    until .not. anyothers
  168. endpro
  169.  
  170.  
  171. *
  172. *-------------------------------------------------------------------------------
  173. * Prozedur: Hauptprogramm
  174. *
  175.  
  176. procedure FORCE_MAIN
  177. parameters char OVERCOME
  178.  
  179. OVERGOT=upper(rtrim(ltrim(OVERCOME)))
  180.  
  181. on error do ERROR_PROC
  182. do scrn_direct
  183.  
  184. set delimiters on
  185. set date german
  186. set status off
  187. set scoreboard off
  188.  
  189. do ShowHeader
  190.  
  191. if .not. ReadCfg()                      && Wenn kein CFG-File
  192.    ?
  193.    ? "Fehler: Datei AUTOHTC.CFG wurde nicht gefunden !!"
  194.    ?
  195.    quit                                 && Abbruch
  196. endif
  197. M_DATE=fgetdate("AUTOHTC.CFG")          && Letztes Hatch-Datum
  198. M_TRENN=trim(M_HPFAD[0])                && Trennzeichen für Downloadcounter
  199.  
  200. if OVERGOT=""                           && Wenn keine Parameter beim Aufruf
  201.    I=1
  202.    do while I<M_AHATCH                  && Aus allen Areas hatchen
  203.       do HATCH                          && Hatchen
  204.       I=I+1
  205.    enddo
  206.    ok=fsetdate("AUTOHTC.CFG",dtoc(today()))
  207. else
  208.    M_HNAME[1]=alltrim(substr(OVERGOT,at(chr(32),OVERGOT),20))
  209.    M_HPFAD[1]=substr(OVERGOT,1,at(chr(32),OVERGOT)-1)
  210.  
  211.    if M_HNAME[1]="" .or. M_HPFAD[1]=""
  212.       ?
  213.       ? "Fehler: Falsche Pfadangabe !!"
  214.       ?
  215.       ? "Beispiel: AUTOHTC <DOS-Pfad> <TagName>"
  216.       ? "          AUTOHTC e:\sdsra SDSRA"
  217.       ?
  218.       quit
  219.    endif
  220.  
  221.    M_DATE="01.01.80"                    && Hatchdatum
  222.    I=1
  223.    do HATCH                             && Hatchen
  224. endif
  225.  
  226. set color to "W/N"
  227. clear
  228. endpro
  229.  
  230.